home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / emacs-18.59src.lha / emacs-18.59 / src / amiga_menu.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-07-01  |  6.7 KB  |  306 lines
  1. #include <exec/types.h>
  2. #include <libraries/gadtools.h>
  3. #include <intuition/intuition.h>
  4. #include <proto/exec.h>
  5. #include <proto/dos.h>
  6. #include <proto/gadtools.h>
  7. #include <proto/intuition.h>
  8. #include "config.h"
  9. #undef NULL
  10. #include "lisp.h"
  11. #include "amiga.h"
  12.  
  13. static struct Menu *emacs_menu;
  14. static char *emacs_menu_strings;
  15. static APTR win_vi;
  16. struct Library *GadToolsBase;
  17.  
  18. void suspend_menus(void)
  19. {
  20.   if (emacs_win)
  21.     {
  22.       ClearMenuStrip(emacs_win);
  23.       if (win_vi)
  24.     {
  25.       FreeVisualInfo(win_vi);
  26.       win_vi = 0;
  27.     }
  28.     }
  29. }
  30.  
  31. int resume_menus(void)
  32. {
  33.   if (emacs_win && emacs_menu)
  34.     {
  35.       win_vi = GetVisualInfo(emacs_win->WScreen, TAG_END);
  36.  
  37.       if (!win_vi || !LayoutMenus(emacs_menu, win_vi,
  38.                   GTMN_NewLookMenus, 1L,
  39.                   TAG_END))
  40.     {
  41.       if (win_vi) FreeVisualInfo(win_vi);
  42.       Famiga_delete_menus();
  43.  
  44.       return FALSE;
  45.     }
  46.       SetMenuStrip(emacs_win, emacs_menu);
  47.     }
  48.   return TRUE;
  49. }
  50.  
  51. DEFUN ("amiga-menus", Famiga_menus, Samiga_menus, 1, 1, 0,
  52.   "Define menus for emacs. The argument is a list structured as follows:\n\
  53.    ((menu1-name ((item1-name item1-expr item1-key item1-disabled) ...)\n\
  54.      menu1-disabled) ...)\n\
  55. menu-name is the name of the menu item header.\n\
  56. The menu is disabled if menu-disabled is not nil [optional].\n\
  57. item-name is the name of an item.\n\
  58. The item-expr fields are ignored.\n\
  59. If item-key is nil, no shortcut is allowed.\n\
  60. If item-disabled is not nil, the item is disabled.\n\
  61. If the item information list is nil, a line is drawn in the menu.\n\
  62. item-key & item-disabled are optional.")
  63.   (menus)
  64.      Lisp_Object menus;
  65. {
  66.     Lisp_Object s_menus, s_items;
  67.     int citems, slen;
  68.     char *strdata;
  69.     struct NewMenu *menudata, *mkm;
  70.     struct Lisp_String *name;
  71.  
  72. /*    int i;
  73.     extern int total[], nb[];
  74.  
  75.     for (i = 0; i < 16; i++)
  76.     {
  77.     printf("%d(%d) ", total[i], nb[i]);
  78.     total[i] = nb[i] = 0;
  79.     }
  80.     printf("\n");
  81.     start_count(15);
  82.     for (i = 0; i < 100; i++) { suspend_count(15); resume_count(15); }
  83.     stop_count(15);
  84.     for (i = 0; i < 100; i++) { start_count(14); stop_count(14); }
  85.     printf("100 s/r: %d, 100 s/s: %d\n", total[15], total[14]);
  86.  
  87.     return Qnil;
  88. */
  89.     check_intuition();
  90.  
  91.     /* Check structure of parameter & count # items & menus */
  92.     s_menus = menus;
  93.     citems = slen = 0;
  94.  
  95.     while (!NULL(s_menus))
  96.     {
  97.     struct Lisp_Cons *menu, *menu_cell;
  98.  
  99.     CHECK_CONS(s_menus, 0);
  100.     menu_cell = XCONS(s_menus);
  101.     citems++;
  102.     CHECK_CONS(menu_cell->car, 0); /* Each menu is a list */
  103.     menu = XCONS(menu_cell->car);
  104.  
  105.     CHECK_STRING(menu->car, 0); /* Check name */
  106.     name = XSTRING(menu->car);
  107.     slen += name->size + 1;
  108.     CHECK_CONS(menu->cdr, 0);
  109.  
  110.     menu = XCONS(menu->cdr); /* Check items */
  111.  
  112.     s_items = menu->car;
  113.     while (!NULL(s_items))
  114.     {
  115.         struct Lisp_Cons *item, *item_cell;
  116.  
  117.         CHECK_CONS(s_items, 0);
  118.         item_cell = XCONS(s_items);
  119.         citems++;
  120.         if (!NULL(item_cell->car))
  121.         {
  122.         CHECK_CONS(item_cell->car, 0); /* Each item is a list */
  123.         item = XCONS(item_cell->car);
  124.  
  125.         CHECK_STRING(item->car, 0);
  126.         name = XSTRING(item->car);
  127.         slen += name->size + 1;
  128.  
  129.         if (!NULL(item->cdr)) /* Only name is necessary */
  130.         {
  131.             CHECK_CONS(item->cdr, 0);
  132.             item = XCONS(item->cdr);
  133.  
  134.             /* Expr is arbitrary */
  135.             if (!NULL(item->cdr))
  136.             {
  137.             CHECK_CONS(item->cdr, 0);
  138.             item = XCONS(item->cdr);
  139.  
  140.             /* Check shortcut */
  141.             if (!NULL(item->car))
  142.             {
  143.                 CHECK_NUMBER(item->car, 0);
  144.                 slen += 2;
  145.             }
  146.  
  147.             if (!NULL(item->cdr))
  148.             {
  149.                 CHECK_CONS(item->cdr, 0);
  150.                 item = XCONS(item->cdr);
  151.  
  152.                 /* Check that end of list */
  153.                 if (!NULL(item->cdr)) error("Badly formed item");
  154.             }
  155.             }
  156.         }
  157.         }
  158.         s_items = item_cell->cdr;
  159.     }
  160.     if (!NULL(menu->cdr))
  161.     {
  162.         CHECK_CONS(menu->cdr, 0);
  163.         menu = XCONS(menu->cdr);
  164.         if (!NULL(menu->cdr)) error("Badly formed menu");
  165.     }
  166.     s_menus = menu_cell->cdr;
  167.     }
  168.  
  169.     suspend_menus();
  170.     if (emacs_menu) Famiga_delete_menus();
  171.  
  172.     /* Now create menu structure */
  173.     menudata = (struct NewMenu *)alloca(sizeof(struct NewMenu) * (citems + 1));
  174.     emacs_menu_strings = strdata = (char *)xmalloc(slen);
  175.     mkm = menudata;
  176.     s_menus = menus;
  177.     while (!NULL(s_menus))
  178.     {
  179.     struct Lisp_Cons *menu, *menu_cell;
  180.     struct NewMenu *menu1;
  181.  
  182.     menu_cell = XCONS(s_menus);
  183.     mkm->nm_Type = NM_TITLE;
  184.     menu = XCONS(menu_cell->car);
  185.     name = XSTRING(menu->car);
  186.     strcpy(strdata, name->data);
  187.     mkm->nm_Label = strdata;
  188.     strdata += name->size + 1;
  189.     mkm->nm_CommKey = 0;
  190.     mkm->nm_Flags = 0;
  191.     mkm->nm_MutualExclude = 0;
  192.     menu1 = mkm++;
  193.  
  194.     menu = XCONS(menu->cdr); /* Check items */
  195.  
  196.     s_items = menu->car;
  197.     while (!NULL(s_items))
  198.     {
  199.         struct Lisp_Cons *item, *item_cell;
  200.  
  201.         item_cell = XCONS(s_items);
  202.         mkm->nm_Type = NM_ITEM;
  203.         mkm->nm_CommKey = 0;
  204.         mkm->nm_Flags = 0;
  205.         mkm->nm_MutualExclude = 0;
  206.         if (NULL(item_cell->car))
  207.         {
  208.         mkm->nm_Type = IM_ITEM;
  209.         mkm->nm_Label = NM_BARLABEL;
  210.         }
  211.         else
  212.         {
  213.  
  214.         item = XCONS(item_cell->car);
  215.         name = XSTRING(item->car);
  216.         strcpy(strdata, name->data);
  217.         mkm->nm_Label = strdata;
  218.         strdata += name->size + 1;
  219.  
  220.         if (!NULL(item->cdr)) /* Only name is necessary */
  221.         {
  222.             item = XCONS(item->cdr);
  223.  
  224.             /* Expr is ignored */
  225.  
  226.             if (!NULL(item->cdr))
  227.             {
  228.             item = XCONS(item->cdr);
  229.  
  230.             /* Check shortcut */
  231.             if (!NULL(item->car))
  232.             {
  233.                 mkm->nm_CommKey = strdata;
  234.                 strdata[0] = XFASTINT(item->car);
  235.                 strdata[1] = '\0';
  236.                 strdata += 2;
  237.             }
  238.             if (!NULL(item->cdr))
  239.             {
  240.                 item = XCONS(item->cdr);
  241.                 if (!NULL(item->car))
  242.                 mkm->nm_Flags |= NM_ITEMDISABLED;
  243.             }
  244.             }
  245.         }
  246.         }
  247.         mkm++;
  248.         s_items = item_cell->cdr;
  249.     }
  250.     if (!NULL(menu->cdr))
  251.     {
  252.         menu = XCONS(menu->cdr);
  253.         if (!NULL(menu->car)) menu1->nm_Flags |= NM_MENUDISABLED;
  254.     }
  255.     s_menus = menu_cell->cdr;
  256.     }
  257.     mkm->nm_Type = NM_END;
  258.     mkm->nm_Label = 0;
  259.     mkm->nm_CommKey = 0;
  260.     mkm->nm_Flags = 0;
  261.     mkm->nm_MutualExclude = 0;
  262.     if (!(emacs_menu = CreateMenus(menudata, TAG_END)))
  263.     {
  264.     free(emacs_menu_strings);
  265.     emacs_menu_strings = 0;
  266.     error("Menu couldn't be created");
  267.     }
  268.     if (!resume_menus()) error("Menu couldn't be layed out");
  269.  
  270.     return Qt;
  271. }
  272.  
  273. DEFUN ("amiga-delete-menus", Famiga_delete_menus, Samiga_delete_menus, 0, 0, 0,
  274.        "Remove & free menu strip")
  275.    ()
  276. {
  277.     check_intuition();
  278.  
  279.     suspend_menus();
  280.     if (emacs_menu) FreeMenus(emacs_menu);
  281.     emacs_menu = 0;
  282.     if (emacs_menu_strings) free(emacs_menu_strings);
  283.     emacs_menu_strings = 0;
  284.  
  285.     return Qt;
  286. }
  287.  
  288. void syms_of_amiga_menu(void)
  289. {
  290.     defsubr(&Samiga_delete_menus);
  291.     defsubr(&Samiga_menus);
  292. }
  293.  
  294. void init_amiga_menu(void)
  295. {
  296.     GadToolsBase = OpenLibrary("gadtools.library", 0);
  297.     if (!GadToolsBase) _fail("gadtools.library required");
  298. }
  299.  
  300. void cleanup_amiga_menu(void)
  301. {
  302.   suspend_menus();
  303.   if (emacs_menu) Famiga_delete_menus();
  304.   if (GadToolsBase) CloseLibrary(GadToolsBase);
  305. }
  306.